home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / tvmenu.arc / MOREMENU.PAS < prev   
Pascal/Delphi Source File  |  1990-12-17  |  3KB  |  130 lines
  1. unit moremenu;
  2.  
  3. { ************************************************************ }
  4. { A simple TMenuBar extension to implement boolean checkmarked }
  5. { menu items.                                                  }
  6. {                                                              }
  7. { Copyright (c) 1990 by Danny Thorpe                           }
  8. {**************************************************************}
  9.  
  10. interface
  11. uses Drivers, Menus;
  12.  
  13. type
  14.   PCheckMarkMenuBar = ^TCheckMarkMenuBar;
  15.   TCheckMarkMenuBar = object(TMenuBar)
  16.     procedure HandleEvent(var E: TEvent); virtual;
  17.     procedure MarkToggle(Cmd: word);
  18.     procedure MarkSet(Cmd : word);
  19.     procedure MarkClear(Cmd: word);
  20.     function  MarkIsSet(Cmd: word): boolean;
  21.     end;
  22.  
  23.  
  24. function FindCmd(AMenu: PMenu; Cmd: word): PMenuItem;
  25.  
  26.  
  27. const MarkChar: char = #251;  { square root symbol }
  28.       MarkStart = 1000; { start of the checkmark command range }
  29.       MarkEnd: word = 1600; { that's 200 checkmark command sets }
  30.  
  31. { checkmark command sets are groups of 3 command constants in
  32.   sequential order.  The first is cmToggle[name], the
  33.   second is cmSet[name], and the third is cmClear[name].  For example:
  34.  
  35. const cmToggleWidget = 1000;  (* the start of the checkmark command range *)
  36.       cmSetWidget = 1001;
  37.       cmClearWidget = 1002;
  38.  
  39. Use cmToggle[name] for the command constant when you init the menu item.
  40. The other commands and methods are for your program to query or explicity
  41. clear or set the checkmark.
  42. }
  43.  
  44. implementation
  45.  
  46. procedure TCheckMarkMenuBar.HandleEvent(var E: TEvent);
  47.   begin
  48.   if E.What = evCommand then
  49.     if (E.Command >= MarkStart) and
  50.        (E.Command <= MarkEnd) then
  51.       begin
  52.       case (E.Command mod 3) of
  53.         (MarkStart mod 3) : MarkToggle(E.Command);
  54.         (MarkStart+1 mod 3) : MarkSet(E.Command-1);
  55.         (MarkStart+2 mod 3) : MarkClear(E.Command-2);
  56.         end;
  57.       ClearEvent(E);
  58.       end;
  59.   TMenuBar.HandleEvent(E);
  60.   end;
  61.  
  62.  
  63. procedure TCheckMarkMenuBar.MarkToggle(Cmd: word);
  64.   begin
  65.   if MarkIsSet(Cmd) then
  66.     MarkClear(Cmd)
  67.   else
  68.     MarkSet(Cmd);
  69.   end;
  70.  
  71.  
  72. procedure TCheckMarkMenuBar.MarkSet(Cmd: word);
  73.   var P: PMenuItem;
  74.   begin
  75.   P := FindCmd(Menu, Cmd);
  76.   if P <> nil then
  77.     P^.Name^[1] := MarkChar;
  78.   end;
  79.  
  80.  
  81. procedure TCheckMarkMenuBar.MarkClear(Cmd: word);
  82.   var P: PMenuItem;
  83.   begin
  84.   P := FindCmd(Menu, Cmd);
  85.   if P <> nil then
  86.     P^.Name^[1] := ' ';
  87.   end;
  88.  
  89.  
  90. function TCheckMarkMenuBar.MarkIsSet(Cmd: word): boolean;
  91.   var P: PMenuItem;
  92.   begin
  93.   MarkIsSet := false;
  94.   P := FindCmd(Menu, Cmd);
  95.   if P <> nil then
  96.     MarkIsSet := (P^.Name^[1] = MarkChar);
  97.   end;
  98.  
  99.  
  100. function FindCmd(AMenu: PMenu; Cmd: word): PMenuItem;
  101.   var P,Q: PMenuItem;
  102.   begin
  103.   P := AMenu^.Items;
  104.   while P <> nil do
  105.     begin
  106.     if (P^.Command = 0) and (P^.Name <> nil) then
  107.       begin
  108.       Q := FindCmd(P^.SubMenu, Cmd);
  109.       if Q <> nil then
  110.         begin
  111.         FindCmd := Q;
  112.         Exit;
  113.         end;
  114.       end
  115.     else
  116.       if (P^.Command = Cmd) and not P^.Disabled then
  117.         begin
  118.         FindCmd := P;
  119.         Exit;
  120.         end;
  121.     P := P^.Next;
  122.     end;
  123.   FindCmd := nil;
  124.   end;
  125.  
  126.  
  127.  
  128. begin
  129. end.
  130.